Delphi --- Sekalaiset 3
VUOSI 2002
// täysin kotimaisella SANANMUUNNOSOHJELMAN koodilla, joten
// ulkomaalaisille tämä ei ehkä "avaudu", mutta matalaotsaiselle, katalakatseiselle
// suomalaiselle voi tulla hymynvire suupieleen kun kirjoittaa Edit1:seen
// vaikkapa PEKKA KAUKALOSSA tms. Jos sanoja on kolme, niin ne pitää liittää alaviivalla
// yhteen esim. JUNTTI_JA HIPPI. Vain yksi välilyönti lauseeseen.
// formilla kaksi Edittiä joitten
// CharCase --> ecUpperCase
// Width --> 177
// tumpelosuoja: Edit2:sen ReadOnly --> True
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
procedure Edit1Change(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Edit2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
muuttunut,onkoekapitk,onkotokapitk: Boolean;
kokosana,sana1,sana2,s1etu,s1taka,s2etu,s2taka : string;
luku: Integer;
v1,v2,eka,toka,k1,jono,avattu : string;
pit,pit2,kat,kat2,ero,ero2,kaikki,onko : integer;
ekak,tokak : Char;
implementation
{$R *.DFM}
procedure TForm1.Edit1Change(Sender: TObject);
begin
kokosana := Edit1.Text ;
pit2 := Length(kokosana);
kat2 := Pos(' ',kokosana);
ero2 := pit2 - kat2;
if kat2 > 2 then //pitää olla 3
begin
if ero2 > 1 then
begin
onkoekapitk := false;
onkotokapitk := false;
luku := Pos(' ',kokosana); //etsitään välilyönti
sana1 := Copy(kokosana, 1, luku-1); //erotetaan ensimmäinen sana
sana2 := Copy(kokosana, luku+1, 30); //erotetaan toinen sana
ekak := sana1[1]; //mikä on ensimmäisen sanan eka kirjain
tokak := sana2[1];//mikä on toisen sanan eka kirjain
if (ekak in ['A','a','E','e','I','i','U','u','O','o','Y','y','Ä','ä','Ö','ö'])
and (sana1[2] = ekak) then onkoekapitk := True;
if (sana1[2] in ['A','a','E','e','I','i','U','u','O','o','Y','y','Ä','ä','Ö','ö'])
then begin
if sana1[2] = sana1[3] then onkoekapitk := True;
end;
if (tokak in ['A','a','E','e','I','i','U','u','O','o','Y','y','Ä','ä','Ö','ö'])
and (sana2[2] = tokak) then onkotokapitk := True;
if (sana2[2] in ['A','a','E','e','I','i','U','u','O','o','Y','y','Ä','ä','Ö','ö'])
then begin
if sana2[2] = sana2[3] then onkotokapitk := True;
end;
if (ekak in ['A','a','E','e','I','i','U','u','O','o','Y','y','Ä','ä','Ö','ö'])
then begin
//jos alkaa vokaalilla then
if onkotokapitk then
s1etu := Copy(sana1, 1, 1)+ekak else
s1etu := Copy(sana1, 1, 1); //eka sanan etuosa
if onkoekapitk then
s1taka := Copy(sana1, 3, 25) else
s1taka := Copy(sana1, 2, 25);//eka sanan takaosa
end
else
begin
//jos EI ala vokaalilla then
if onkotokapitk then
s1etu := Copy(sana1, 1, 2)+sana1[2] else
s1etu := Copy(sana1, 1, 2); //eka sanan etuosa
if onkoekapitk then //jos ekasanassa pitkä vokaali
s1taka := Copy(sana1, 4, 25) else //poistetaan ekasanasta vielä yksi kirjain
s1taka := Copy(sana1, 3, 25);
end;
if (tokak in ['A','a','E','e','I','i','U','u','O','o','Y','y','Ä','ä','Ö','ö'])
then begin //jos alkaa vokaalilla then
if onkoekapitk then
s2etu := Copy(sana2, 1, 1)+tokak else
s2etu := Copy(sana2, 1, 1); //toka sanan etuosa
if onkotokapitk then
s2taka := Copy(sana2, 3, 25) else
s2taka := Copy(sana2, 2, 25);//toka sanan takaosa
end
else
begin
//jos EI ala vokaalilla then
if onkoekapitk then
s2etu := Copy(sana2, 1, 2)+sana2[2] else
s2etu := Copy(sana2, 1, 2);
if onkotokapitk then //jos tokasanassa pitkä vokaali
s2taka := Copy(sana2, 4, 25) else
s2taka := Copy(sana2, 3, 25);
end;
Edit2.Text := s2etu + s1taka +' '+s1etu + s2taka;
end
else
begin
Edit2.Text := '';
end;
end
else
begin
Edit2.Text := '';
end;
end;//Edit1Change
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var T: string;
begin
if Key = chr(32) then //ei kahta välilyöntiä
begin
T := Edit1.Text;
if Pos(' ', T) > 0 then key := #0;
end;
end;
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key = VK_DELETE then
begin
Edit1.Clear; //putsataan editit
Edit2.Clear;
end;
end;
procedure TForm1.Edit2Click(Sender: TObject);
begin
Edit1.SetFocus; //Jos tumpelo klikkaa Edit2:seen, focus 1:seen
end;
end.
// HUH, olipa pitkä ja hankala tarkistaa toimiiko tuo ollenkaan??!!.
// Lepuutetaan hermoja Jimi Hendrixin "Message to the universe" kappaleella
// ja nappulat kaakkoon.
Voit siirtää formilla olevia "komponentteja" pikseli kerrallaan:
Valitse yksi tai useampi "komponentti", paina Ctrl pohjaan...
pidä pohjassa ja liikuta nuolinäppäimillä.
Voit myös muuttaa valitun "komponentin" kokoa nuolinäppäimillä pitämällä
Vaihto (Shift) näppäin pohjassa.
//Jos sovelluksessa on vain yksi edit, ja enterin painalluksella Windows "piippaa"
//laita Edit1KeyPressin viimeiseksi riviksi: if key = Char(VK_RETURN) then Key := #0;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
//koodia
//...
//...
if Key = #13 then
begin
//vaikka enter on käytössä
end;
//...
//...
//...
if key = Char(VK_RETURN) then Key := #0; //ärsyttävä windowsin ääni pois
end;
//Vain salasanalla ohjelma käyntiin. Ohjelmassa vain yksi formi,
InputBox:illa kysytään salasana ja MessageDlg:llä herjataan väärästä.( 9.2.2002 )
unit sala1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Mask;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
annettu_salasana : string; //sisäänpyrkijän salasana
const
Salasana = 'jiihaa'; //salasana
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject); //FormGreateen
begin
annettu_salasana := InputBox('Tarkistus', 'Kirjoita salasana', '');
if annettu_salasana <> Salasana then
begin
MessageDlg('VÄÄRÄ SALASANA, POISTU OHJELMASTA', mtInformation,
[mbOk], 0);
end;
end;
procedure TForm1.FormActivate(Sender: TObject); //FormActivateen
begin
if annettu_salasana <> Salasana then
Application.Terminate; //suljetaan ohjelma
end;
end.
//Jos joku tapahtuma pitää olla kahden näppäimen takana,
tässä Ctrl + F12, laita KeyDowniin:
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; //KeyDown:iin
Shift: TShiftState);
begin
//...
//...
if ((Shift = [ssCtrl]) and (key = VK_F12)) then //huom. sulut!!
begin
//jos Ctrl on pohjassa ja näpätään F12
end;
//...
//...
end;
//Shift:in muut arvot:
//ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble
// Käynnistää tietokoneen uudelleen
ExitWindowsEx( EWX_REBOOT, 0 );
Jos haluat että sovelluksesi on sekä 95, 98, ME että XP yhteensopiva,
älä käytä clNone värimääritystä.
XP näyttää esim. Radio Button komponentin täysin mustana???
Etsit jonkun ohjelman oikeaa nimeä esim: Muistio = NOTEPAD.EXE ja
Rekisterieditori = regedit.exe,
ja haluat löytää vaikka XP:ssä olevan OnScreen näppäimistön "oikean" nimen.
Käynnistä Delphin apuohjelma WinSight.
Tämä windowsin viestien vakoiluohjelma (ws32.exe) näyttää rivin:
Overlapped 00140520 {OSKMainClass} osk.EXE (352,534)-(964,729) "OnScreen-näppäimistö".
Vapaasti suomennettuna: Overlapped = tavanomainen ikkuna, tyyli WS_OVERLAPPED,
00140520 = ikkunan kahva (HWND)?
{OSKMainClass} = luokkanimi
osk.EXE = ohjelman nimi
(352,534)-(964,729) = ikkunan koko ja asema
"OnScreen-näppäimistö" = ikkunan otsikkorivin teksti.
Tästä voi päätellä että ohjelman oikea nimi on osk.exe.
Testaa vielä nimi Käynnistä, suorita ja kirjoita osk -> ok
Kuvitellaan että tarvitaan kolme vierekkäistä RadioButton1 komponenttia RadioGroup1:in sisään
Pudota RadioGroup1 formille ja nimeä se.
Avaa Object Inspectorissa RadioGroup1:en Items ominaisuudesta String List editor.
Kirjoita kolme riviä(kolme RadioButtonia), eli annat nyt nimet RadioButtoneille.
Niin monta RadioButtonia luodaan, kuinka monta riviä kirjoitat.
Kirjoita vaikka:
Eka
Toka
Kolmas
Paina OK, RadioGroupissa on nyt kolme päällekkäistä RadioButtonia.
Takaisin Object Inspectoriin, RadioGroup1:en Columns arvoa muuttamaan.
Arvolla 1 RadioButtonit on päällekkäin, 2:sella "hajallaan", 3:sella vierekkäin,
4:sella ja sitä suuremmalla RadioButtoneiden väli pienenee.
Testaa että kaikki on kunnossa, vetämällä RadioGrouppia, jos RadioButtonit pysyy mukana,
niin kaikki on ok.
Vielä pitäisi laittaa vaikka Toka RadioButton oletuksena päälle,
laita RadioGroup1:en ItemIndex arvoksi 1 (0 on eka), kuittaa enterillä.
//Tulostaa txt tiedoston muistiolla niin, ettei naapurin "Erkkikään" tiedä
millä se tulostettiin (SW_HIDE). Tosin Eki voi päätellä sivunumeroinnista
ym. jotain häikkää...Laita uses rimpsuun ShellApi, niin toimii hiukan paremmin.
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
ShellExecute(Handle, 'print', 'esim.txt', nil, nil, SW_HIDE);
end;
//Formilla ListBox ja nappi.
Jos ListBox:issa on valittuna esim www.canon.fi (eihän ole mainontaa?)
niin käynnistetään selain ja otetaan yhteys ko. sivulle.
Toimii myös jos rivinä on http alkuinen,
vaikkapa http://netti.nic.fi/~perpo. 12.03.2003
procedure TForm1.SpeedButton1Click(Sender: TObject);
var jono: array[0..79] of Char;
begin
if ListBox1.ItemIndex >= 0 then
begin // jos rivejä
if ListBox1.items[ListBox1.ItemIndex]<> '' then
begin //jos jotain
StrPCopy(jono, ListBox1.items[ListBox1.ItemIndex]);
ShellExecute(Handle, nil, jono, '', '', SW_SHOWNORMAL);
end; //jos jotain
end; // jos rivejä
end;
//Tähänkin pitää laittaa uses rimpsuun ShellApi.
//Pariton vai parillinen luku ?
if odd(StrToInt(FloatToStr(PVMErotus))) then //vaihda odd() sulkujen sisältö!!
begin
// pariton
end
else
begin
// parillinen
end;
( imuroi --> WWW-apu ohjelma* 326 kt ),jota voi hyödyntää
esim. laskujen maksamisessa (leikepöytä).
Tympii kirjoitella samoja sanoja: ajoneuvohallintokeskus, sanoma magazines finland,
sonera entrum oy, ym. ym.
Tai voit pitää ohjelmaa korpulla ja surffalla suosikkisivuille mistä vain
(Suosikit aina mukana).
Toimii vain jos ne on muotoa www tai http:// alkuisia.
Kukapa muistaa jotain sivua (vaikkapa www.webmobil24.de/web/fi/start/p/index.htm)
kirjastossa. Tosin jos kirjastotäti huomaa, että tunkaset USB-pulikan heidän koneeseen,
voi kirjastotädin kengänkärki ja WWW-apu ohjelman käyttäjän häntäluu kohdata
tuhoisin seurauksin.
Ohjelmassa on myös kalenteri, (tai oikeammin päivien poimintakomponentti) jossa on
kaksi eri päivienlaskentaa. Joko aina kuluvasta päivästä johonkin tai itse
määrätyistä päivistä. Voit katsoa montako päivää vielä on jäljellä, ennen kuin
seuraavaan kerran "pähkinäpussi" maksetaan tilillesi.
WWW-apu ohjelma toimii vain alustalla johon voi kirjoittaa, korppu tai kiintolevy.
Johtuen kahdesta txt-tiedostosta ( ppvm.txt ja wwwapu.txt ) joita ohjelma käyttää.
Tiedostoon ppvm.txt tallennetaan ensimmäinen pistospäivämäärä. Jonka jälkeen ohjelma
näyttää (muistuttaa) joka toinen päivä kuvakkeella onko pistospäivä vai ei.
Betaferon, ei huumeet ;-)
Tallennuksesta ei tarvitse huolehtia mitenkään.
* versio 0.0.0.3 6.6.2003
-Lisätty mm. ominaisuus, joka erottaa ensimmäinen merkkijonon ennen välilyöntiä ja vie
sen leikepöydälle. Ominaisuutta voi käyttää esim. netistä tilatessa.
Useinhan niissä on tilausnumero, jolla tuotetta voi sivuilta hakea ja tilata.
Jos listassasi on tallennettuna vaikkapa:
153757 Marshall MG100DFX guitars Combo, 100 Watts, napilla voit erottaa
leikepöydälle vain tuon tilausnumeron.
* versio 0.0.0.4 13.1.2004 XP versio + pieniä korjauksia
-Selkeytetty rakennetta, suosikit tallennetaan erikseen. Lisätty mm. ominaisuus
käynnistellä omia, tarpeellisiksi katsomiaan ohjelmia* wwwapu-ohjelmasta.
Eli nyt *.txt tiedostoja on neljä: ppvm.txt, wwwapu.txt, ohjelmat.txt ja suosikit.txt
Ohjelma.exe nimen jälkeen voi nimeä "kommentoida", eli luetaan vain ensimmäiseen
välilyöntiin asti.(esim: uba.exe Laskee onko ylä-vaiko alamäkiä enemmän)
Otetaan allaoleva USB-muisti, ladataan ohjelmat palikkaan ja siirrytään koneelle
jossa on nopea internetyhteys.
Nyt vain USB-muisti koneeseen kiinni ja ledi välkkymään.
*Käynnistettävä ohjelma pitää olla samassa kansiossa kuin pääohjelma.
//Trim funktiolla eroon välilyönneistä merkkijonon etu- ja takapuolelta
procedure TForm1.BitBtn1Click(Sender: TObject);
var mjono: String;
begin
mjono := ' joopa joo '; // merkkijono
Edit1.Text := trim(mjono); //= 'joopa joo'
end;
Labelille ja StaticTextille ei tulostu & merkkiä, vaan alaviiva _??
- Laita ShowAccelChar arvo Object Inspectorissa Falseksi.
//Nappulan teksti päällekkäin 14.2.2004
procedure Tmain.FormCreate(Sender: TObject); //Pääformin Greateen
begin
nappi.Caption := 'Eka rivi' + #10 + 'Toka rivi';
end;
//Lyhyt ohjelma ympyrän piirtämiseen
procedure TForm1.Button1Click(Sender: TObject);
var
X,Y,S,K,L,f,g,kulma : Integer;
begin
X:=200; //ympyrän keskipiste vaakas.
Y:=200; //ympyrän keskipiste pystys.
S:=150; //ympyrän säde.
K:=90; //kaaren alku asteina
L:=360; //kaaren loppu asteina
Canvas.Pen.Width:=1;
Canvas.Pen.Color:= clRed;
Canvas.MoveTo(X,Y); // siirretään kohdistin ympyrän keskelle
For kulma := K to L do
begin
f:=Round(cos(((2*pi*kulma)/360))*S); // Y
g:=Round(sin(((2*pi*kulma)/360))*S); // X
Canvas.LineTo(X+g,Y-f);
/// // Canvas.Pixels[X+g,Y-f]:= clred;
end;
end;
