procedure Alpha_Triangle(p1,p2,p3: tpoint;r,g,b,ratio: byte; bit1: tbitmap);
{
p1,p2,p3 = the 3 vertices or points at the corners of the triangle
r,g,b = the red, green, and blue values being averaged with the colours behind
ratio = a value from 0 to 255 that determines how opaque the fill of the triangle will be
-> 0 for transparent, 255 for completely opaque, however,
in either of these extremes, it doesn't make sence to use this procedure
bit1 = the bitmap having the triangle drawn on
}
// this function draws a filled triangle
// by dividing it in half and stepping through
// each line
var
x,y: integer;
height: integer; // looping variables
dx_right,dx_left: real;
// the dx/dy ratio of the right and left edges of the line
xs, xe: real; // // the starting and ending points of the edges
temp_x, temp_y: integer;
right_x,left_x: integer;
pb: pbytearray;
w: integer; // (width of bitmap) * (# of bytes per pixel)
x2: integer; // x*(# of bytes per pixel)
miny,maxy,minx,maxx: integer;
nratio: byte;
begin
if (p1.x<0)and(p2.x<0)and(p3.x<0) then
exit;
if (p1.y<0)and(p2.y<0)and(p3.y<0) then
exit;
maxx:=bit1.width-1;
if (p1.x>maxx)and(p2.x>maxx)and(p3.x>maxx) then
exit;
maxy:=bit1.height-1;
if (p1.y>maxy)and(p2.y>maxy)and(p3.y>maxy) then
exit;
// exit if none of the triangle will be shown anyway
nratio:=255-ratio;
bit1.PixelFormat:=pf24bit;
w:=bit1.width*3;
// make sure points are in order
if (p2.y < p1.y) then
begin
temp_y := p1.y;
temp_x := p1.x;
p1.y := p2.y;
p1.x := p2.x;
p2.y := temp_y;
p2.x := temp_x;
end;
if (p3.y < p1.y) then
begin
temp_y := p1.y;
temp_x := p1.x;
p1.y := p3.y;
p1.x := p3.x;
p3.y := temp_y;
p3.x := temp_x;
end;
if (p3.y < p2.y) then
begin
temp_y := p3.y;
temp_x := p3.x;
p3.y := p2.y;
p3.x := p2.x;
p2.y := temp_y;
p2.x := temp_x;
end;
left_x := p2.x;
if p3.y=p1.y then
right_x := 10000
else
right_x := round(p1.x + (p2.y-p1.y)*(p3.x-p1.x)/(p3.y-p1.y));
if (right_x < left_x)then // messes up if right is on left
begin
temp_x := right_x;
right_x := left_x;
left_x := temp_x;
end;
/////!!DRAW TOP!!///////
//draw the triangle top
if (p1.y <> p2.y) then
begin
// compute height of subtriangle
height := p2.y - p1.y;
// set starting points
xs := p1.x;
xe := p1.x;
// compute edge ratios
dx_left := (left_x - p1.x) / height;
dx_right := (right_x - p1.x) / height;
///DRAW IT ALREADY!!!!
miny:=max(0,p1.y);
maxy:=min(bit1.height-1,p2.y);
for y := miny to maxy do
begin
pb:=bit1.ScanLine[y];
minx:=max(0,trunc(xs));
maxx:=min(bit1.width-1,trunc(xe));
for x := minx to maxx do
begin
x2:=x*3;
pb[x2]:=(pb[x2]*nratio+b*ratio) shr 8;
pb[x2+1]:=(pb[x2+1]*nratio+g*ratio) shr 8;
pb[x2+2]:=(pb[x2+2]*nratio+r*ratio) shr 8;
end;
//adjust starting and ending point
xs :=xs+ dx_left;
xe :=xe+ dx_right;
end;
end;
if (p2.y <> p3.y) then
begin
//now recompute slope of shorter edge to finish triangle bottom
// recompute slopes
height := p3.y - p2.y;
dx_right := (p3.x - right_x) / (height);
dx_left := (p3.x - left_x) / (height);
xs := left_x;
xe := right_x;
if p3.y>= bit1.height then
p3.y:=bit1.height-1; // prevent an access violation error
// draw the rest of the triangle
miny:=max(0,p2.y+1);
maxy:=min(bit1.height-1,p3.y);
for y := miny to maxy do
begin
pb:=bit1.ScanLine[y];
minx:=max(0,trunc(xs));
maxx:=min(bit1.width-1,trunc(xe));
for x := minx to maxx do
begin
x2:=x*3;
pb[x2]:=(pb[x2]*nratio+b*ratio) shr 8;
pb[x2+1]:=(pb[x2+1]*nratio+g*ratio) shr 8;
pb[x2+2]:=(pb[x2+2]*nratio+r*ratio) shr 8;
end;
//adjust starting and ending point
xs :=xs+ dx_left;
xe :=xe+ dx_right;
end; //end for
end;
end;

info : Planetsourcecode.com

procedure TfrmMainHair.FillTreeViewWithDates(Tree : TTreeview; Format : String; NumberOfYears : Integer);

var
h, i, j, z : Integer;

sDate : String;

Year, Month, Day : Word;

YearNode, MonthNode, DayNode : TTreeNode;

Const

MonthsInYear : Array [0..11] of String = ('January', 'February', 'March', 'April', 'May',

'June', 'July', 'August', 'September', 'October', 'November', 'December');

DaysInMonth : Array [0..11] of Integer = (31,28,31,30,31,30,31,31,30,31,30,31);

begin

YearNode := Nil;

DecodeDate(Date, Year, Month, Day);

{set default integers}

z := 0;

Tree.Items.BeginUpdate;

{years will be a variable that the user can configure, make sure user does not select years > 9999}

for h := 0 to NumberOfYears - 1 do

begin

if NumberOfYears > 1 then

begin

YearNode := Tree.Items.Add(Nil,IntToStr(Year));// Child(Tree.TopItem, IntToStr(Year));

YearNode.ImageIndex := 0;

YearNode.SelectedIndex := 0;

end;

{loop for how ever many months}

for i := 0 to high(MonthsInYear) - (high(MonthsInYear) - 2) do

begin

{add a new month each pass}

if NumberOfYears > 1 then

MonthNode := Tree.Items.AddChild(YearNode, MonthsInYear[Month - 1] + ' ' + IntToStr(Year))

Name : Random String Generator With Patterns and Extra Options
Description :Creates Random Strings of a specific length. There r sum options that u can use, and u can set ur own pattern. So, it can b pretty useful. Hope it is. :) if u want to c the code implemented in a Program, u can take a look at mycode example that i submitted. I'll put the link when i get it.

Function GenStr(MaxLen,Restrictions:Integer):String;Overload;
{Possible Resctiction Values:
1 - All
2 - Just Letters and Numbers
3 - Just Numbers
4 - Just Letters
}
Var St:Byte;
Total:String;
begin
Repeat
Randomize;
St := Random(255);
// All Caracters
If Restrictions = 1 then
Total := Total + chr(St);
//Just Letters and Numbers
If Restrictions = 2 then
If (St >= 48) and (St <= 57) or (St >= 65) and (St <= 90) or (St >= 97) and (St <= 122) then
Total := Total + chr(St);
//Just Numbers
If Restrictions = 3 then
If (St >= 48) and (St <= 57) then
Total := Total + chr(St);
//Just Letters
If Restrictions = 4 then
If (St >= 65) and (St <= 90) or (St >= 97) and (St <= 122) then
Total := Total + chr(St);
Until Length(Total) = MaxLen;
Result := Total;
end;
Function GenStr(MaxLen:Integer;Pattern:String):String;Overload;
{Possible Resctiction Values:
1 - All
2 - Just Letters and Numbers
3 - Just Numbers
4 - Just Letters
Possble Pattern Parameters:
A or a - All
L - Letter In Capitals
l - Letter not in capitals
C or c - Character ( A,B or a,b (etc.))
N or n - Numbers
R or r - Random Generated Pattern
Ex:
If u wanted a generated string that was Number, number,number,Captiol
letter then any letter, u would use this pattern:
NNNLC or NNNLc
}
Var St:Byte;
Total:String;
Ptrn:String;
P:Byte;
PtrnCount:Integer;
begin
//If pattern is set to random, we need to make a pattern ourselves
If (Pattern = 'R') or (Pattern = 'r') then
Begin
repeat
//Get ready for random
Randomize;
//Get random number
P := Random(225);
//Check to c if its a pattern number or not (ASCII values of A,N,L,l,etc.
Case P of
//A or a
65 or 97:Ptrn := Ptrn + 'A';
//L
78:Ptrn := Ptrn + 'L';
//l
108:Ptrn := Ptrn + 'l';
//C or c
67 or 99:Ptrn := Ptrn + 'C';
//N or n
78 or 110:Ptrn := Ptrn + 'N';
end;
until Length(Ptrn) = (MaxLen div 2) + 1;
//Set the New Pattern
Pattern := Ptrn;
end;
//String Generation Section
PtrnCount := 0;
Repeat
//Prepare to random
Randomize;
//Add 1 to PtrnCount
Inc(PtrnCount);
//A or a //Everything Is OK
If (Pattern[PtrnCount] = 'A') or (Pattern[PtrnCount] = 'a') then
Total := Total + chr(Random(255));
//L //Just Capitol Letters
If (Pattern[PtrnCount] = 'L') then
Begin
Repeat
//Get random number
St := Random(255);
Until (St >= 65) and (St <= 90);
Total := Total + chr(St);
end;
//l //Letters, but not it capitols
If (Pattern[PtrnCount] = 'l') then
Begin
Repeat
//Get random number
St := Random(255);
Until (St >= 97) and (St <= 122);
Total := Total + chr(St);
end;
//C or c //Any letter, wether its a capitol or not
If (Pattern[PtrnCount] = 'C') or (Pattern[PtrnCount] = 'c') then
begin
Repeat
//Get random number
St := Random(255);
Until (St >= 65) and (St <= 90) or (St >= 97) and (St <= 122);
Total := Total + chr(St);
end;
//N or n //Number
If (Pattern[PtrnCount] = 'N') or (Pattern[PtrnCount] = 'n') then
begin
Repeat
//Get random number
St := Random(255);
Until (St >= 48) and (St <= 57);
Total := Total + chr(St);
end;
//IF PtrnCount is at it's max, reset it
If PtrnCount = Length(Pattern) then
PtrnCount := 0;
Until Length(Total) = MaxLen;
Result := Total;
end;

info : planetsorcecode.com

procedure TForm1.Timer1Timer(Sender: TObject);

var

i,len,width: integer;

begin

with listbox1 do

begin

width := 0;

for i := 0 to items.count -1 do

begin

len := canvas.textwidth(items[i]);

if len > width then width := len;

end;

//set listbox's horizontal scrollbar width

Perform(LB_SETHORIZONTALEXTENT,width+100,0);

end;

end;

This function will read the file version information from your application's executable file. It does this through the Win32 API functions GetFileVersionInfoSize(), GetFileVersionInfo(), and VerQueryValue(). This can be very useful if you have your IDE set to increment build numbers each time you compile your project, as it can be used to return the current version number. Since I use the version number in a lot of my applications, it's really a pain to have to update a global constant each time the version number changes. This makes it much easier. Please note: I found a version of this code in the Borland Delphi 6 help files, and modified it so it would be a function, and return only the file version information. Additionally, there were very few comments, so I commented much of the code as well. You can view the original code if you do a search in the help files for "Reading version information".

function Application_Version: String;
const
InfoNum = 10;
InfoStr: array[1..InfoNum] of string = ('CompanyName', 'FileDescription', 'FileVersion', 'InternalName', 'LegalCopyright', 'LegalTradeMarks', 'OriginalFileName', 'ProductName', 'ProductVersion', 'Comments');
var
S: string; n, Len, i: DWORD;
Buf: PChar; Value: PChar;
begin
S := Application.ExeName; //this application's EXE filename
n := GetFileVersionInfoSize(PChar(S), n); // the return value is the size in bytes of the file's version information.
Result := ''; (* this sets a default result in case a file version isn't found.
I add this to functions because the compiler will bug you that
the result may not be defined otherwise. you could change this,
or remove it alltogether, although it's probably best to leave it. *)
if n > 0 then begin
Buf := AllocMem(n); // allocate the needed amount of memory into the buffer
GetFileVersionInfo(PChar(S), 0, n, Buf); // store the file version information in the memory buffer. it stores all of the values listed in the InfoStr array.
for i := 1 to InfoNum do
if VerQueryValue(Buf, PChar('StringFileInfo\040904E4\' + InfoStr[i]), Pointer(Value), Len) then
if trim(lowerCase(InfoStr[i])) = 'fileversion' then Result := Value;// loop through each value until we find the "FileVersion" information.
FreeMem(Buf, n); // free the memory we stored in the buffer.
end;
end;

//Declare private string for the unit
implementation
var

TokS: string


//Function To Get Characters From The String function StrMid(const sData: string; nStart: integer; nLength: integer): string; overload;
begin

Result := copy(sData, nStart, nLength);

end;

//Function To Get Characters From The String function StrMid(const sData: string; nStart: integer): string; overload;
begin

Result := copy(sData, nStart, Length(sData) - (nStart - 1));

end;

//String Tokenizer function
function StrTok(S: string; Tok: string = ''): string;
var

i,
LenTok: integer;

begin

if not(S = '') then begin //New String

TokS := S;
result := '';
Exit;

end;

if Tok = '' then begin //If No Token

result := TokS;
Exit;

end;

LenTok := Length(Tok);
for i := 0 to Length(TokS) - LenTok do begin

if StrMid(TokS, i, LenTok) = Tok then begin //If Token Found

result := StrMid(TokS, 1, i - LenTok);
TokS := StrMid(TokS, i + LenTok + 1);
Exit;

end;

end;

//If Program Reaches Here, Return The Rest Of The String
result := TokS;
TokS := '';

end;


Therefore, for example, if you defined a string:
var

S: string


and set S to 'Hello World'

S := 'Hello World';


and then call StrTok() like so:

StrTok(S);

The procedure will store the string, from now on, calling StrTok() with no S value and a token (such as a space ' '), the program will return everything in the string up to the token.

EX:
var

firstWord,
secondWord: string


begin

StrTok(S);
firstWord := StrTok('', ' ');
secondWord := StrTok('', ' ');

end;

//Doing this will break apart the string S at the token (' ') into the first word and the second word.

procedure Delay(ms : longint);
var
TheTime : LongInt;
begin
TheTime := GetTickCount + ms;
while GetTickCount < TheTime do Application.ProcessMessages;
end;